home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio 2000
/
Ham Radio 2000.iso
/
ham2000
/
misc
/
dspice0s
/
sorstp.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-21
|
6KB
|
206 lines
/* sorstp.f -- translated by f2c (version of 3 February 1990 3:36:42).
You must link the resulting object file with the libraries:
-lF77 -lI77 -lm -lc (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct {
doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin,
reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
pivrel;
} knstnt_;
#define knstnt_1 knstnt_
struct {
integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt,
nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
} cirdat_;
#define cirdat_1 cirdat_
struct {
doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu,
sfactr;
integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno,
itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
} status_;
#define status_1 status_
struct {
doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas,
rstats[50];
integer iwidth, lwidth, nopage;
} miscel_;
#define miscel_1 miscel_
struct {
integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod,
lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
} flags_;
#define flags_1 flags_
struct {
doublereal value[200000];
} blank_;
#define blank_1 blank_
/*< subroutine sorstp(itlim) >*/
/* Subroutine */ int sorstp_(itlim)
integer *itlim;
{
/* Format strings */
static char fmt_110[] = "(\0020 source stepping method failed\002)";
/* Builtin functions */
double sqrt();
integer s_wsfe(), e_wsfe();
/* Local variables */
extern /* Subroutine */ int iter8_();
static doublereal bound, fractn;
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)
/* Fortran I/O blocks */
static cilist io__5 = { 0, 0, 0, fmt_110, 0 };
/*< implicit double precision (a-h,o-z) >*/
/* this routine uses the source stepping method to solve the dc */
/* operating point */
/* spice version 2g.6 sccsid=knstnt 3/15/83 */
/*< common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
/*< 1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
/*< 2 pivtol,pivrel >*/
/* spice version 2g.6 sccsid=cirdat 3/15/83 */
/*< common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
/*< 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
/* spice version 2g.6 sccsid=status 3/15/83 */
/*< common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
/*< 1 xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
/*< 2 iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
/* spice version 2g.6 sccsid=miscel 3/15/83 */
/*< common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
/*< 1 defas,rstats(50),iwidth,lwidth,nopage >*/
/* spice version 2g.6 sccsid=flags 3/15/83 */
/*< common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
/*< 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
/* spice version 2g.6 sccsid=blank 3/15/83 */
/*< common /blank/ value(200000) >*/
/*< integer nodplc(64) >*/
/*< complex cvalue(32) >*/
/*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
/*< bound=1.0d0/64 >*/
bound = .015625;
/*< fractn=1.0d0/16 >*/
fractn = .0625;
/* step down sources */
/*< 10 fractn=fractn*2.0d0 >*/
L10:
fractn *= 2.;
/*< sfactr=sfactr*fractn >*/
status_1.sfactr *= fractn;
/*< if (sfactr.lt.bound) go to 100 >*/
if (status_1.sfactr < bound) {
goto L100;
}
/*< initf=2 >*/
status_1.initf = 2;
/*< call iter8(itlim) >*/
iter8_(itlim);
/*< rstats(6)=rstats(6)+iterno >*/
miscel_1.rstats[5] += status_1.iterno;
/*< if (igoof.ne.0) go to 10 >*/
if (flags_1.igoof != 0) {
goto L10;
}
/*< fractn=2.0d0 >*/
fractn = 2.;
/* step up sources */
/*< 20 sfactr=sfactr*fractn >*/
L20:
status_1.sfactr *= fractn;
/*< if (sfactr.le.1.0d0) go to 30 >*/
if (status_1.sfactr <= 1.) {
goto L30;
}
/*< sfactr=1.0d0 >*/
status_1.sfactr = 1.;
/*< 30 initf=3 >*/
L30:
status_1.initf = 3;
/*< call iter8(itlim) >*/
iter8_(itlim);
/*< rstats(6)=rstats(6)+iterno >*/
miscel_1.rstats[5] += status_1.iterno;
/*< if ((igoof.eq.0).and.(sfactr.eq.1.0d0)) go to 200 >*/
if (flags_1.igoof == 0 && status_1.sfactr == 1.) {
goto L200;
}
/*< if (igoof.eq.0) go to 20 >*/
if (flags_1.igoof == 0) {
goto L20;
}
/* step down if step up failed */
/*< 40 fractn=dsqrt(fractn) >*/
L40:
fractn = sqrt(fractn);
/*< if (fractn.lt.1.0001d0) go to 100 >*/
if (fractn < 1.0001) {
goto L100;
}
/*< sfactr=sfactr/fractn >*/
status_1.sfactr /= fractn;
/*< initf=3 >*/
status_1.initf = 3;
/*< call iter8(itlim) >*/
iter8_(itlim);
/*< rstats(6)=rstats(6)+iterno >*/
miscel_1.rstats[5] += status_1.iterno;
/*< if (igoof.ne.0) go to 40 >*/
if (flags_1.igoof != 0) {
goto L40;
}
/*< go to 20 >*/
goto L20;
/* finish with source stepping method */
/*< 100 igoof=1 >*/
L100:
flags_1.igoof = 1;
/*< write(iofile,110) >*/
io__5.ciunit = status_1.iofile;
s_wsfe(&io__5);
e_wsfe();
/*< 110 format('0 source stepping method failed') >*/
/*< 200 initf=2 >*/
L200:
status_1.initf = 2;
/*< return >*/
return 0;
/*< end >*/
} /* sorstp_ */
#undef cvalue
#undef nodplc